<%
'***************************************************
'
'类名称   ：YimonTemplate 模板引擎
'文件版本 ：1.3 (2011-01-22)
'交流论坛 : http://www.puissite.net
'官方网站 ：http://www.yimon.com
'作者     ：流氓鱼 (QQ：951786588，E-Mail:webmaster@yimon.com)
'说明     ：模板引擎类。
'备注     ：本程序由 创意联盟工作室 开发。仅供学习使用，不得用于商业用途。如有asp爱好者修改其中Bug，请寄份到作者邮箱。谢谢！
'
'***************************************************
'''todo 待修改
Class YimonTemplate
	Public templates_dir,templates_cache,templates_html_file,templates_html_cache,templates_default,templates_new,templates_time
	Public templates_postfix,templates_auto,templates_caching,templates_charset
	Public templates_file,templates_cache_file,templates_cache_time,templates_name,templates_message,FSO,I,Reg
	
	'构造函数
    Private Sub Class_Initialize()
		templates_cache       = "/yimontemplate/utf8/data/templates/"          '缓存模板路径，请使用绝对路径
		templates_html_cache  = "/yimontemplate/utf8/data/cache/"              '纯html代码缓存路径，请使用绝对路径
		templates_dir         = "/yimontemplate/utf8/templates/default/"       '模板路径，请使用绝对路径
		templates_default     = "/yimontemplate/utf8/templates/default/"       '默认模板路径，请使用绝对路径
		templates_new         = false                                               '设置当次更新
		templates_time        = 60                                                  '模板缓存过期时间,分钟计算
		'以下的默认设置
		templates_postfix     = ".html"              '模板后缀
		templates_auto        = true                 '自动更新模板
		templates_caching     = ".asp"               '模板缓存后缀
		'结果集
		templates_file        = array()              '模板文件
		templates_cache_file  = array()              'html缓存文件名
		templates_cache_time  = array()              'html缓存文件更新时间
		templates_name        = ""                   '标识名
		templates_message     = ""                   'html内容
		templates_charset     = "utf-8"
		
		Set FSO = CreateObject("Scripting.FileSystemObject")
		Set Reg = New Regexp
		Reg.ignorecase = False
		Reg.global = True
		I = 1
		ReDim Preserve templates_file(I)
		ReDim Preserve templates_cache_file(I)
		ReDim Preserve templates_cache_time(I)
		
		'禁止默认模板目录不存在
		If FSO.FolderExists(Server.MapPath(templates_default)) = False Then
			Error("请先设置默认模板路径和缓存路径")
		End If
	End Sub
    'ob_get_contents获取执行后代码。
	Private Function ob_get_contents(path)
		Dim tmp, a, b, t, matches, m
		Dim str 
		str = ReadFile(path)
		tmp = "dim htm : htm = """""&vbcrlf
		a = 1
		b = instr(a,str,"<%")+2
		While b > a+1
			t = mid(str,a,b-a-2)
			t = replace(t,vbcrlf,"{::vbcrlf}")
			t = replace(t,vbcr,"{::vbcr}")
			t = replace(t,"""","""""")
			tmp = tmp & "htm = htm & """ & t & """" & vbcrlf
			a = instr(b,str,"%\>")+2
			tmp = tmp & preg_replace("^\s*=","htm = htm & ",mid(str,b,a-b-2)) & vbcrlf
			b = instr(a,str,"<%")+2
		Wend
		t = mid(str,a)
		t = replace(t,vbcrlf,"{::vbcrlf}")
		t = replace(t,vbcr,"{::vbcr}")
		t = replace(t,"""","""""")
		tmp = tmp & "htm = htm & """ & t & """" & vbcrlf
		tmp = replace(tmp,"response.write","htm = htm & ",1,-1,1)
		tmp = replace(tmp,"Display(","htm = htm & Display(",1,-1,1)
		'Response.Write(tmp)
		Execute(tmp)
		'Executeglobal(tmp)
		htm = replace(htm,"{::vbcrlf}",vbcrlf)
		htm = replace(htm,"{::vbcr}",vbcr)
		ob_get_contents = htm
	End Function

	'Include O
	Public Function Include(FileName)
		Response.Write(ob_get_contents(FileName))
	End Function

	'GetVar
	Private Function GetVar(var_name)
	    Execute("Function GetVarValue(): GetVarValue=" & var_name  & ": End Function")
	    GetVar = GetVarValue()
	End Function
	
	'replace_html
	Private Function replace_html(Str)
		Dim Matches, Result, Html,Match,regvar
		Html   = Str
		regvar = "([\w\(\)]+?)"
		'过滤 <!--{}-->
		Html = preg_replace("\<\!\-\-\{(.+?)\}\-\-\>","{$1}",Html)
		'替换变量
		Html = preg_replace("\{\$"&regvar&"\}", "<"&"%=$1%"&">",Html)
		'替换模板载入
		Html = preg_replace("\{template\s+\$"&regvar&"\}", "<"&"%Display($1,True)%"&">",Html)
		Html = preg_replace("\{template\s+(.+?)\}", "<"&"%Display(""$1"",True)%"&">",Html)
		Reg.Pattern = "\{templatesub\s+(.+?)\}"
		Set Matches = Reg.Execute(Html)
		For Each Match In Matches
			Html = Replace(Html, Match.Value, replace_html(ReadFile(Get_Path(Match.SubMatches(0)))))
		Next
		'替换循环函数及条件判断语句
		Html = preg_replace("\{foreach\s+(.+?)\s+(.+?)\}", "<"&"%For Each $1 In $2%"&">",Html)
		Html = preg_replace("\{for\s+(.+?)\s+(.+?)\}", "<"&"%For $1 To $2%"&">",Html)
		Html = Replace(Html,"{/next}","<"&"%Next%"&">")
		Html = preg_replace("\{(do|loop)\s+(while|until)\s+(.+?)\}","<"&"%$1 $2 $3%"&">",Html)
		Html = Replace(Html,"{do}","<"&"%Do%"&">")
		Html = Replace(Html,"{loop}","<"&"%Loop%"&">")
		Html = preg_replace("\{while\s+(.+?)\}"	,"<"&"%While $1%"&">",Html)
		Html = Replace(Html,"{/wend}","<"&"%Wend%"&">")
		Html = preg_replace("\{if\s+(.+?)\}","<"&"%If $1 Then%"&">",Html)
		Html = preg_replace("\{elseif\s+(.+?)\}","<"&"%ElseIf $1 Then%"&">",Html)	
		Html = Replace(Html,"{/if}","<"&"%End If%"&">")
		Html = Replace(Html,"{else}","<"&"%Else%"&">")
		'替换特定函数
		Html = preg_replace("\{eval\s+(.+?)\}","<"&"% $1 %"&">",Html)
		Html = preg_replace("\{echo\s+(.+?)\}","<"&"%=$1%"&">",Html)
		Reg.Pattern = "\{html\s+\$"&regvar&"\}"
		Set Matches = Reg.Execute(Html)
		For Each Match In Matches
			Html = Replace(Html, Match.Value, replace_html(GetVar(Match.SubMatches(0))))
		Next
		Set Matches = Nothing
		replace_html = Html
	End Function
	
	'判断缓存过期时间并获取缓存  string.html:是否返回html字符串 bool.time:缓存过期时间 int(分钟)
	Public Function CacheGet(FileName, html , Time)
		Dim CacheFile:CacheFile = templates_html_cache & FileName & ".html"
		Dim CacheTime:CacheTime = Time * 60
		If Is_File(CacheFile) and DateDiff("s",DateLastModified(CacheFile),now) < CacheTime Then
				If html Then
					CacheGet = ReadFile(CacheFile)
				Else
					Server.Execute(CacheFile)
				End If
		Else
			CacheGet = True
		End If
	End Function
	
	'CacheSet生成HTML缓存文件
	Public Function CacheSet(Content,FileName)
		Dim CacheFile
		CacheFile = templates_html_cache & FileName & ".html"
		Call CreateFile(CacheFile,Content)
	End Function
	
	'preg_replace 正则替换
	Private Function preg_replace(pattern,s,str)
		Dim tmp : tmp = false
		Reg.pattern = pattern
		tmp = Reg.Replace(str,s)
		preg_replace = tmp
	End Function
	
	'Display解析开始
	Public Function Display(file_name,html)
		Dim cachefile
		If file_name="" Then
			Response.Write("Template file does not exist")
			Response.End()
		End If
		'取得路径
		templates_file(I) = Get_Path(file_name)
		
		'取得文件名字
		templates_name = file_name

		'取得缓存路径
		templates_cache_file(I) = Get_Path("")
		
		'判断一下文件是否存在。 是否已经过期，然后生成并且显示。
		If(Check(templates_name)) Then
			ReDim Preserve templates_file(I+1)
			ReDim Preserve templates_cache_file(I+1)
			ReDim Preserve templates_cache_time(I+1)
			cachefile = templates_cache_file(I)
			Display = View(cachefile,html)
			Exit Function
		End If

		templates_message = null
		If(Is_File(templates_file(I))) Then
			templates_message = replace_html(readfile(templates_file(I)))
		End If
		ReDim Preserve templates_file(I+1)
		ReDim Preserve templates_cache_file(I+1)
		ReDim Preserve templates_cache_time(I+1)		
		Display = View(fileplus(),html)
	End Function

	'ReadFile
	Private Function ReadFile(FilePath)
		Dim ADO,Tmp  
		Set ADO = Server.CreateObject("adodb.stream")
		With ADO
			.Type=2  
			.Mode=3  
			.CharSet = templates_charset   
			.Open   
			.LoadFromFile Server.MapPath(FilePath)   
				Tmp=.ReadText   
			.Close
		End With
		Set ADO = Nothing   
		ReadFile = Tmp
	End Function
	
	'CreateFile O
	Private Sub CreateFile(FileP,body)
		Dim FF,NewsFold,Fold,CreateFolder,J,FilePath
		FilePath = Server.MapPath(FileP)
		Fold = ""
		NewsFold = Split(FilePath, "/")
		For J = 0 To UBound(NewsFold)-1
			If(Fold="") Then
				Fold=NewsFold(j)
			Else
				Fold=Fold&"\"&NewsFold(j)
			End If
			If Not FSO.FolderExists(Server.MapPath(Fold)) Then  
			Set FF = FSO.CreateFolder(Server.MapPath(Fold))
				CreateFolder=FF.Path
			Set FF=nothing
        	End If
    	Next
		Set FF = FSO.CreateTextFile(FilePath)
			FF.Write body
		Set FF = Nothing
		
		Set FF = Server.CreateObject("adodb.stream") 
		With FF  
			.Type = 2  
			.Mode = 3  
			.Charset = templates_charset   
			.Open   
			.Writetext body   
			.SaveToFile FilePath,2  
			.Flush   
			.Close
		End With   
		set FF = Nothing  
	End Sub
	
	'DateLastModified O
	Private Function DateLastModified(FilePath)
		Dim FF
		If(FSO.FileExists(Server.MapPath(FilePath))) Then
			Set FF = FSO.GetFile(Server.MapPath(FilePath))
			DateLastModified = FF.DateLastModified  '最后更新时间
			Set FF = Nothing
		Else
			DateLastModified = False
		End If
	End Function

	'文件存在判断 Is_File O
	Private Function Is_File(filespec)
		If (FSO.FileExists(Server.MapPath(filespec))) Then
			Is_File = true
		Else
			Is_File = false
		End If
	End Function

	'文件夹存在判断 Is_Folder O
	Private Function Is_Folder(filespec)
		If (FSO.FolderExists(Server.MapPath(filespec))) Then
			Is_Folder = true
		Else
			Is_Folder = false
		End If
	End Function

	'显示出来 View O
	Private Function View(path_asp,html)
		If(Is_File(path_asp)) Then
			If html Then
				View = ob_get_contents(path_asp)
			Else
				Response.Write(ob_get_contents(path_asp))
				View = True
			End If
		Else
			Response.Write(path_asp & " Does not exist<br>")
			View = False
		End If
	End Function

	'生成缓存 fileplus O
	Private Function fileplus()
		Call CreateFile(templates_cache_file(I),templates_message)
		templates_message = ""
		fileplus = templates_cache_file(I)
	End Function

	'路径处理 Get_Path O
	Private Function Get_Path(file_name)
		'为默认路径做完整路径抓取
		Dim file_all,file
		path()
		If(file_name <> "") Then
			file_all = templates_dir & file_name & templates_postfix
			If(templates_dir = "" Or Is_File(file_all) = False) Then
				file_all = templates_default & file_name & templates_postfix
			End If
			
			If(Is_File(file_all) = False) Then
				Get_Path = False
				Response.Write(file_all)
				Error("Template file does not exist or an error")
			End If
			
			Get_Path = file_all
		Else
			file = Replace(templates_name,"/","_")
			file = Replace(file,"\","_")
			Get_Path = templates_cache & "cachefile_" & file & templates_caching
			templates_cache_time(I) = templates_cache & "cachetime_" & file & templates_caching
		End If
	End Function
	
	'路径规范处理 Path O
	Private Function Path()
		If(Len(templates_dir)<=2) Then
			Error("Catalog Error")
		End If
		If(Len(templates_cache)<=2) Then
			Error("Catalog Error")
		End If
	End Function

	'错误处理 Error O
	Private Function Error(Str)
		Response.Write(Str)
		Response.End()
	End Function
	
	'控制判断 Check O
	Private Function Check(name)
		Dim CacheTime
		'对文件及目录判断
		If(templates_name="") Then
			templates_name = "index"
		End If

		 '检查默认模板目录是否存在
		If(Is_Folder(templates_dir)=False) Then
			Error("Templates directory does not exist")
		End If
		
		'检查缓存模板目录是否存在
		If(Is_Folder(templates_cache)=False) Then
			Error("Template cache directory does not exist")
		End If

		'判断缓存文件是否存在,不存在就报错.
		If(Is_File(templates_file(I))=False)Then
			Error("Template does not exist: " & name)
		End If
		
		CacheTime = Replace(Replace(templates_name,"/","_"),"\","_")
		If Is_File(templates_cache_time(I)) And Is_File(templates_cache_file(I)) Then
			Include(templates_cache_time(I))
			If(GetVar(CacheTime) = "") Then
				Call CreateFile(templates_cache_time(I),"<"&"% "&CacheTime&"="""&DateLastModified(templates_file(I))&""" %"&">")
				Check = False
				Exit Function
			Else
				If(DateDiff("s",GetVar(CacheTime),DateLastModified(templates_file(I))) > 0) Then
					Call CreateFile(templates_cache_time(I),"<"&"% "&CacheTime&"="""&DateLastModified(templates_file(I))&""" %"&">")
					Check = False
					Exit Function
				Else
					If(templates_auto=false) Then '如果不自动更新，就直接调用缓存。
						If (templates_new) Then '当次更新
							Check = False
							Exit Function
						End If
						Check = True
						Exit Function
					ElseIf DateDiff("s",DateLastModified(templates_cache_file(I)),now) >= templates_time*60 Then
						Check = False
						Exit Function
					End If
					Check = True
					Exit Function
				End If
			End If
		Else
			Call CreateFile(templates_cache_time(I),"<"&"% "&CacheTime&"="""&DateLastModified(templates_file(I))&""" %"&">")
			Check = False
			Exit Function
		End If
		
		Check = False
	End Function

    '析构函数
    Private Sub Class_Terminate()
    	Set FSO = Nothing
		Set Reg = Nothing
    End Sub
End Class
%>